home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / I18N / Collate.pm
Encoding:
Perl POD Document  |  1999-12-28  |  3.5 KB  |  139 lines
  1. package I18N::Collate;
  2.  
  3. =head1 NAME
  4.  
  5. I18N::Collate - compare 8-bit scalar data according to the current locale
  6.  
  7.   ***
  8.  
  9.   WARNING: starting from the Perl version 5.003_06
  10.   the I18N::Collate interface for comparing 8-bit scalar data
  11.   according to the current locale
  12.  
  13.     HAS BEEN DEPRECATED
  14.  
  15.   That is, please do not use it anymore for any new applications
  16.   and please migrate the old applications away from it because its
  17.   functionality was integrated into the Perl core language in the
  18.   release 5.003_06.
  19.  
  20.   See the perllocale manual page for further information.
  21.  
  22.   ***
  23.  
  24. =head1 SYNOPSIS
  25.  
  26.     use I18N::Collate;
  27.     setlocale(LC_COLLATE, 'locale-of-your-choice'); 
  28.     $s1 = new I18N::Collate "scalar_data_1";
  29.     $s2 = new I18N::Collate "scalar_data_2";
  30.  
  31. =head1 DESCRIPTION
  32.  
  33. This module provides you with objects that will collate 
  34. according to your national character set, provided that the 
  35. POSIX setlocale() function is supported on your system.
  36.  
  37. You can compare $s1 and $s2 above with
  38.  
  39.     $s1 le $s2
  40.  
  41. to extract the data itself, you'll need a dereference: $$s1
  42.  
  43. This module uses POSIX::setlocale(). The basic collation conversion is
  44. done by strxfrm() which terminates at NUL characters being a decent C
  45. routine.  collate_xfrm() handles embedded NUL characters gracefully.
  46.  
  47. The available locales depend on your operating system; try whether
  48. C<locale -a> shows them or man pages for "locale" or "nlsinfo" or the
  49. direct approach C<ls /usr/lib/nls/loc> or C<ls /usr/lib/nls> or
  50. C<ls /usr/lib/locale>.  Not all the locales that your vendor supports
  51. are necessarily installed: please consult your operating system's
  52. documentation and possibly your local system administration.  The
  53. locale names are probably something like C<xx_XX.(ISO)?8859-N> or
  54. C<xx_XX.(ISO)?8859N>, for example C<fr_CH.ISO8859-1> is the Swiss (CH)
  55. variant of French (fr), ISO Latin (8859) 1 (-1) which is the Western
  56. European character set.
  57.  
  58. =cut
  59.  
  60.  
  61. use POSIX qw(strxfrm LC_COLLATE);
  62.  
  63. require Exporter;
  64.  
  65. @ISA = qw(Exporter);
  66. @EXPORT = qw(collate_xfrm setlocale LC_COLLATE);
  67. @EXPORT_OK = qw();
  68.  
  69. use overload qw(
  70. fallback    1
  71. cmp        collate_cmp
  72. );
  73.  
  74. sub new {
  75.   my $new = $_[1];
  76.  
  77.   if ($^W && $] >= 5.003_06) {
  78.     unless ($please_use_I18N_Collate_even_if_deprecated) {
  79.       warn <<___EOD___;
  80. ***
  81.  
  82.   WARNING: starting from the Perl version 5.003_06
  83.   the I18N::Collate interface for comparing 8-bit scalar data
  84.   according to the current locale
  85.  
  86.     HAS BEEN DEPRECATED
  87.  
  88.   That is, please do not use it anymore for any new applications
  89.   and please migrate the old applications away from it because its
  90.   functionality was integrated into the Perl core language in the
  91.   release 5.003_06.
  92.  
  93.   See the perllocale manual page for further information.
  94.  
  95. ***
  96. ___EOD___
  97.       $please_use_I18N_Collate_even_if_deprecated++;
  98.     }
  99.   }
  100.  
  101.   bless \$new;
  102. }
  103.  
  104. sub setlocale {
  105.  my ($category, $locale) = @_[0,1];
  106.  
  107.  POSIX::setlocale($category, $locale) if (defined $category);
  108.  $LOCALE = $locale || $ENV{'LC_COLLATE'} || $ENV{'LC_ALL'} || '';
  109. }
  110.  
  111. sub C {
  112.   my $s = ${$_[0]};
  113.  
  114.   $C->{$LOCALE}->{$s} = collate_xfrm($s)
  115.     unless (defined $C->{$LOCALE}->{$s}); # cache when met
  116.  
  117.   $C->{$LOCALE}->{$s};
  118. }
  119.  
  120. sub collate_xfrm {
  121.   my $s = $_[0];
  122.   my $x = '';
  123.   
  124.   for (split(/(\000+)/, $s)) {
  125.     $x .= (/^\000/) ? $_ : strxfrm("$_\000");
  126.   }
  127.  
  128.   $x;
  129. }
  130.  
  131. sub collate_cmp {
  132.   &C($_[0]) cmp &C($_[1]);
  133. }
  134.  
  135.  
  136. &I18N::Collate::setlocale();
  137.  
  138. 1; # keep require happy
  139.